home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / shazam.exe / GDESKTOP.IMP < prev    next >
Text File  |  1992-09-01  |  17KB  |  483 lines
  1.    {*******************************************************************
  2.  
  3.    GDESKTOP.IMP
  4.  
  5.    *******************************************************************}
  6.    {===================================================================
  7.  
  8.    HISTORY
  9.  
  10.    ===================================================================}
  11.    {-------------------------------------------------------------------
  12.    SAVE
  13.    -------------------------------------------------------------------}
  14. procedure SaveHistory ( VAR S : TStream ) ;
  15. var
  16.    Size                      : word ;
  17. begin
  18.    if S.Status <> stOk then EXIT ;
  19.    Size                      := HistoryUsed
  20.                                 - PtrRec ( HistoryBlock ).Ofs ;
  21.    S.Write ( Size , SizeOf ( Word ) ) ;
  22.    S.Write ( HistoryBlock^ , Size ) ;
  23. end ;
  24.    {-------------------------------------------------------------------
  25.    LOAD
  26.    -------------------------------------------------------------------}
  27. procedure LoadHistory ( VAR S : TStream ) ;
  28. var
  29.    Size                      : word ;
  30. begin
  31.    if S.Status <> stOk then EXIT ;
  32.    S.Read ( Size , SizeOf ( Word ) ) ;
  33.    S.Read ( HistoryBlock^ , Size ) ;
  34.    if S.Status = stOk then
  35.       HistoryUsed               := PtrRec ( HistoryBlock ).Ofs
  36.                                    + Size
  37.    else
  38.       ClearHistory ;
  39. end ;
  40.    {===================================================================
  41.  
  42.    PALETTE - saves all three (3) palettes.  Note that we do NOT want to
  43.    save the actual "AppPalette", since we would lose auto-detect.  This
  44.    could happen when using dual monitors, changing from color to B&W or
  45.    vice-versa, and (no doubt) there are other possibilities.
  46.  
  47.    To force a palette, use command-line switches and call hdColor,
  48.    hdBlackWhite or hdMonochrome AFTER application starts.
  49.  
  50.    ===================================================================}
  51.    {-------------------------------------------------------------------
  52.    SAVE
  53.    -------------------------------------------------------------------}
  54. procedure SavePalette ( VAR S : TStream ) ;
  55. var
  56.    SaveAppPalette            : integer ;
  57.    P                         : PString ;
  58. begin
  59.    if S.Status <> stOk then EXIT ;
  60.    SaveAppPalette            := AppPalette ;
  61.    for AppPalette := apColor to apMonochrome do
  62.    begin
  63.       P                      := NewStr ( Application^.GetPalette^ ) ;
  64.       S.WriteStr ( P ) ;
  65.       DisposeStr ( P ) ;
  66.    end ;
  67.    AppPalette                := SaveAppPalette ;
  68. end ;
  69.    {-------------------------------------------------------------------
  70.    LOAD
  71.    -------------------------------------------------------------------}
  72. procedure LoadPalette ( VAR S : TStream ) ;
  73. var
  74.    SaveAppPalette            : integer ;
  75.    P                         : PString ;
  76. begin
  77.    if S.Status <> stOk then EXIT ;
  78.    SaveAppPalette            := AppPalette;
  79.    for AppPalette := apColor to apMonochrome do
  80.    begin
  81.       P                      := S.ReadStr ;
  82.       Application^.GetPalette^ := TPalette ( P^ ) ;
  83.       DisposeStr ( P ) ;
  84.    end ;
  85.    AppPalette                := SaveAppPalette ;
  86.    if S.Status <> stOk then
  87.       hdResetColors ;
  88.    hdRefreshDisplay ;
  89. end ;
  90.    {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  91.  
  92.    DESKTOP - Must apply TEditor Load/Store patch!
  93.  
  94.    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  95.    {===================================================================
  96.  
  97.    STORE
  98.  
  99.    ===================================================================}
  100. procedure DesktopWriteViews ( VAR S : TStream ) ;
  101.    {-------------------------------------------------------------------
  102.    IF VISIBLE
  103.    -------------------------------------------------------------------}
  104. procedure WriteView ( P : PView ) ; FAR ;
  105. begin
  106.    if P = Desktop^.Last then EXIT ;
  107.    if P^.GetState ( sfVisible ) then
  108.       S.Put ( P ) ;
  109. end ;
  110.    {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  111.    PROCESS
  112.    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
  113. begin
  114.    if S.Status <> stOk then EXIT ;
  115.    Desktop^.ForEach ( @WriteView ) ;
  116.    S.Put ( NIL ) ;
  117. end ;
  118.    {===================================================================
  119.  
  120.    LOAD - One at a time; "ValidView" calls "OutOfMemory" if LowMemory
  121.           is TRUE.
  122.  
  123.    NOTE:  Default "OutOfMemory" does nothing - should be overridden.
  124.  
  125.    ===================================================================}
  126. procedure DesktopReadViews ( VAR S : TStream ) ;
  127. var
  128.    P                         : PView ;
  129. begin
  130.    if S.Status <> stOk then EXIT ;
  131.    while TRUE do
  132.    begin
  133.       P                   := PView ( S.Get ) ;
  134.       Desktop^.InsertBefore ( Application^. ValidView ( P ) ,
  135.                               Desktop^.Last ) ;
  136.       if P = NIL then EXIT ;
  137.    end ;
  138. end ;
  139.    {===================================================================
  140.  
  141.    SAVE
  142.  
  143.    ===================================================================}
  144. procedure SaveDesktopTo ( FileName : PathStr ; Description : string ) ;
  145. var
  146.    Strm                      : PStream ;
  147. begin
  148.    if FileName = '' then EXIT ;
  149.    SaveEdUntitled ;                                        { save, or }
  150.    CloseEdUntitled ;                                   { dump empties }
  151.    SaveEdModified ;                                    { keep changes }
  152.    Strm                      := New ( PDosStream ,
  153.                                       Init ( FileName ,
  154.                                              stCreate ) ) ;
  155.    Description               := Description + #26 ;
  156.    Strm^.Write ( Description[1] , length ( Description ) ) ;
  157.    Strm^.Write ( VersionCode[0] , length ( VersionCode ) + 1 ) ;
  158.    SaveHistory ( Strm^ ) ;
  159.    SavePalette ( Strm^ ) ;
  160.    DesktopWriteViews ( Strm^ ) ;
  161.    if Strm^.Status <> stOk then
  162.    begin
  163.       FileErase ( FileName ) ;
  164.       MessageBox ( ^C'Could not create'#13
  165.                     + FileName ,
  166.                       NIL ,
  167.                       mfError + mfOkButton ) ;
  168.    end ;
  169.    Dispose ( Strm , Done ) ;
  170. end ;
  171.    {===================================================================
  172.  
  173.    LOAD
  174.  
  175.    ===================================================================}
  176. procedure LoadDesktopFrom ( FileName : PathStr ) ;
  177. var
  178.    Strm                      : PStream ;
  179.    VersionCodeTest           : string ;
  180.    Ch                        : char ;
  181. begin
  182.    if not FileExist ( FileName ) then EXIT ;
  183.    CloseAll ;
  184.    Strm                      := New ( PDosStream ,
  185.                                       Init ( FileName ,
  186.                                              stOpenRead ) ) ;
  187.    Ch                        := #0 ;
  188.    while ( Ch <> ^Z ) and ( Strm^.Status = stOK ) do
  189.       Strm^.Read ( Ch , 1 ) ;
  190.    Strm^.Read ( VersionCodeTest [0] , 1 ) ;
  191.    Strm^.Read ( VersionCodeTest [1] , length ( VersionCode ) ) ;
  192.    if VersionCode = VersionCodeTest then
  193.    begin
  194.       LoadHistory ( Strm^ ) ;
  195.       LoadPalette ( Strm^ ) ;
  196.       DesktopReadViews ( Strm^ ) ;
  197.    end
  198.    else
  199.    begin
  200.       Strm^.Seek ( 0 ) ;
  201.       Strm^.Truncate ;
  202.       Strm^.Reset ;
  203.       if Application <> NIL then
  204.          MessageBox ( ^C'DESKTOP version change to ' + VersionCode ,
  205.                       NIL ,
  206.                       mfWarning + mfOKButton ) ;
  207.    end ;
  208.    if Strm^.Status <> stOk then
  209.       MessageBox ( ^C'Error reading desktop file'#13
  210.                    + FileName ,
  211.                    NIL ,
  212.                    mfError + mfOkButton ) ;
  213.    Dispose ( Strm , Done ) ;
  214. end ;
  215.    {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  216.  
  217.    EVENT
  218.  
  219.    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  220.    {===================================================================
  221.  
  222.    COMMAND - easy way to pass commands
  223.  
  224.    ===================================================================}
  225. procedure CommandAll ( Command : word ) ;
  226.    {-------------------------------------------------------------------
  227.    Send command
  228.    ---------------------------------------------------